-----------------------------------------------------------------------------
-- Copyright 2012-2024, Microsoft Research, Daan Leijen.
--
-- This is free software; you can redistribute it and/or modify it under the
-- terms of the Apache License, Version 2.0. A copy of the License can be
-- found in the LICENSE file at the root of this distribution.
-----------------------------------------------------------------------------
module Compile.CodeGen ( codeGen, Link, LinkResult(..), noLink ) where

import Debug.Trace
import Data.Char
import Data.Maybe
import Data.List
import Data.Either
import Control.Monad
import System.Directory ( doesFileExist, doesDirectoryExist, createDirectoryIfMissing )

import Platform.Config        ( version, exeExtension, dllExtension, libPrefix, libExtension, pathSep, sourceExtension )

import Lib.PPrint hiding (dquote)
import Lib.Printer
import Common.Error
import Common.Range
import Common.Name
import Common.Syntax
import Common.ColorScheme
import Common.File
import Common.Failure
import Kind.Assumption( KGamma )
import Kind.Newtypes( Newtypes )
import Type.Type
import Type.Assumption( Gamma )
import Type.Pretty( Env(colorizing,coreIface,coreShowDef,context,importsMap) )
import Syntax.Syntax
import Syntax.Colorize( colorize )
import Syntax.GenDoc( genDoc )

import qualified Core.Core as Core
import qualified Core.Pretty
import Core.Borrowed( Borrowed )

import Backend.CSharp.FromCore    ( csharpFromCore )
import Backend.JavaScript.FromCore( javascriptFromCore )
import Backend.C.FromCore         ( cFromCore )

import Compile.Options
import Compile.Module( Definitions(..), Module(..), modCoreImports )
import Compile.TypeCheck( importMapFromCoreImports )    -- todo: break this dependency?
import Type.InferMonad (traceDefDoc)


data LinkResult = LinkDone
                | LinkExe{ linkExePath :: !FilePath, linkRun :: !(IO ()) }

type Link       = [Module] -> IO LinkResult

noLink :: Link
noLink _ = return LinkDone

{---------------------------------------------------------------
  Code generation
---------------------------------------------------------------}

codeGen :: Terminal -> Flags -> (IO () -> IO ()) -> Newtypes -> Borrowed -> KGamma -> Gamma ->
             Maybe (Name,Type) -> [Module] -> Module -> IO Link
codeGen term flags sequential newtypes borrowed kgamma gamma entry imported mod
  = -- compilerCatch ("code generation in " ++ show (modName mod)) term noLink $
    do let program    = fromJust (modProgram mod)
           core       = fromJust (modCore mod)

           importsMap = importMapFromCoreImports (programImports program) (modCoreImports mod)
           penv       = (prettyEnvFromFlags flags){ context = modName mod, importsMap = importsMap }
           outBase    = noexts (modIfacePath mod)
           inlineDefs = case modInlines mod of
                          Right defs -> defs
                          Left _     -> []
           ifaceDoc   = Core.Pretty.prettyCore penv{ coreIface = True } (target flags) inlineDefs core
                         <-> Lib.PPrint.empty
           coreDoc    = Core.Pretty.prettyCore penv{ coreIface = False, coreShowDef = (showCore flags) } (target flags) inlineDefs core
                         <-> Lib.PPrint.empty

       -- create output directory if it does not exist
       direxist <- doesDirectoryExist (dirname (modIfacePath mod))
       when (not direxist) $
         sequential (createDirectoryIfMissing True (dirname (modIfacePath mod)))

       -- remove existing kki file in case of errors
       removeFileIfExists (modIfacePath mod)

       -- core
       when (genCore flags)  $
         do termTrace term "generate core"
            let outCore  = outBase ++ ".kkc"
            writeDocW 10000 outCore coreDoc  -- just for debugging

       when (showCore flags || (showFinalCore flags && not (isTargetC (target flags)))) $
         do termInfo term coreDoc

       -- write documentation
       let fullHtml = outHtml flags > 1
           outHtmlFile  = outBase ++ "-source.html"
           source   = modSource mod -- maybe sourceNull programSource (modProgram mod)
           cenv     = penv{ colorizing=True }
       if (isLiteralDoc (sourceName source)) -- .kk.md
        then do termTrace term "write html document"
                withNewFilePrinter (outBase ++ ".md") $ \printer ->
                 colorize (modRangeMap mod) cenv kgamma gamma fullHtml (sourceName source) 1 (sourceBString source) printer
        else when (outHtml flags > 0) $
              do termTrace term "write html source"
                 withNewFilePrinter outHtmlFile $ \printer ->
                  colorize (modRangeMap mod) cenv kgamma gamma fullHtml (sourceName source) 1 (sourceBString source) printer
                 termTrace term "write html documentation"
                 withNewFilePrinter (outBase ++ ".xmp.html") $ \printer ->
                  genDoc cenv kgamma gamma core printer

       -- generate actual code
       link <- backend term flags sequential entry outBase core

       -- return the link as an action to increase concurrency
       return $ \fullImports ->
         -- compilerCatch ("linking in " ++ show (modName mod)) term LinkDone $
         do mbRun <- link fullImports
            -- write interface file last so on any error it will not be written
            writeDocW 10000 (modIfacePath mod) ifaceDoc

            -- copy final exe if -o is given
            case mbRun of
              LinkExe out _
                -> do let finalOut = outFinalPath flags
                      exe <- if (not (null finalOut))
                                then do let targetOut = ensureExt finalOut (targetExeExtension (target flags))
                                        when onMacOS $
                                          removeFileIfExists targetOut  -- needed on macOS due to code signing issues (see https://developer.apple.com/forums/thread/669145)
                                        copyBinaryFile out targetOut
                                        return finalOut
                                else return out
                      termPhase term $ color (colorInterpreter (colorScheme flags)) (text "created :") <+>
                          color (colorSource (colorScheme flags)) (text (normalizeWith pathSep exe))
              _ -> return ()
            return (mbRun)
  where
    backend :: Terminal -> Flags -> (IO () -> IO ()) -> Maybe (Name,Type) -> FilePath -> Core.Core -> IO Link
    backend  = case target flags of
                 CS   -> codeGenCS
                 JS _ -> codeGenJS
                 _    -> {-
                         let -- for Perceus (Parc) we analyze types inside abstract types and thus need
                             -- access to all defined types; here we freshly extract all type definitions from all
                             -- imported modules.
                             newtypesAll = foldr1 newtypesCompose (map (extractNewtypes . modCore) (loadedModule loaded : loadedModules loaded))
                         in -}
                         codeGenC (modSourcePath mod) newtypes borrowed 0 {-unique-}


{---------------------------------------------------------------
  C#
---------------------------------------------------------------}

-- Generate C# through CS files without generating dll's
codeGenCS :: Terminal -> Flags -> (IO () -> IO ()) -> Maybe (Name,Type) -> FilePath -> Core.Core -> IO Link
codeGenCS term flags sequential entry outBase core
  = compilerCatch "csharp compilation" term noLink $
    do let (mbEntry,isAsync) = case entry of
                                 Just (name,tp) -> (Just (name,tp), isAsyncFunction tp)
                                 _ -> (Nothing, False)
           cs  = csharpFromCore (buildType flags) (enableMon flags) mbEntry core
           outcs       = outBase ++ ".cs"
           searchFlags = "" -- concat ["-lib:" ++ dquote dir ++ " " | dir <- [fullBuildDir flags] {- : includePath flags -}, not (null dir)] ++ " "
           outName fname = joinPath (dirname outBase) fname

       termTrace term $ "generate csharp" ++ maybe "" (\(name,_) -> ": entry: " ++ show name) mbEntry
       writeDoc outcs cs
       when (showAsmCS flags) (termInfo term cs)

       case mbEntry of
         Nothing -> return noLink
         Just _  ->
          do let linkFlags  = "-r:System.Numerics.dll " -- ++ (if isAsync then "-r:" ++ outName "std_async.dll ")
                 sources    = concat [dquote (outName (moduleNameToPath (Core.importName imp)) ++ ".cs") ++ " " | imp <- Core.coreProgImports core]
                 targetExe  = (if null (outBaseName flags) then outBase else outName (outBaseName flags)) ++ exeExtension
                 targetName = dquote targetExe
                 targetFlags= "-t:exe -out:" ++ targetName ++ " "
                 debugFlags = (if (debug flags) then "-debug -define:DEBUG " else "") ++ (if (optimize flags >= 1) then "-optimize " else "")
             let cmd = (csc flags ++ " " ++ targetFlags ++ debugFlags ++ " -nologo -warn:4 " ++ searchFlags ++ linkFlags ++ sources)
             runSystemEcho term flags cmd
             -- run the program
             return (\_ -> return (LinkExe targetExe (runSystemEcho term flags targetName)))

-- CS code generation via libraries; this catches bugs in C# generation early on but doesn't take a transitive closure of dll's
codeGenCSDll:: Terminal -> Flags -> (IO () -> IO ()) -> Maybe (Name,Type) -> FilePath -> Core.Core -> IO Link
codeGenCSDll term flags sequential entry outBase core
  = compilerCatch "csharp compilation" term noLink $
    do let (mbEntry,isAsync) = case entry of
                                 Just (name,tp) -> (Just (name,tp), isAsyncFunction tp)
                                 _ -> (Nothing, False)
           cs  = csharpFromCore (buildType flags) (enableMon flags) mbEntry core
           outcs       = outBase ++ ".cs"
           searchFlags = "" -- concat ["-lib:" ++ dquote dir ++ " " | dir <- [fullBuildDir flags] {- : includePath flags -}, not (null dir)] ++ " "
           outName fname = joinPath (dirname outBase) fname

       termTrace term $ "generate csharp" ++ maybe "" (\(name,_) -> ": entry: " ++ show name) mbEntry
       writeDoc outcs cs
       when (showAsmCS flags) (termInfo term cs)

       let linkFlags  = concat ["-r:" ++ outName (moduleNameToPath (Core.importName imp)) ++ dllExtension ++ " "
                                    | imp <- Core.coreProgImports core] -- TODO: link to correct package!
                        ++ "-r:System.Numerics.dll " ++ (if isAsync then "-r:" ++ outName "std_async.dll " else "")
           targetName = case mbEntry of
                          Just _ -> dquote ((if null (outBaseName flags) then outBase else outName (outBaseName flags)) ++ exeExtension)
                          _      -> dquote (outBase ++ dllExtension)
           targetFlags= case mbEntry of
                          Just _ -> "-t:exe -out:" ++ targetName
                          _      -> "-t:library -out:" ++ targetName
           debugFlags = (if (debug flags) then "-debug " else "") ++ (if (optimize flags >= 1) then "-optimize " else "")
       let cmd = (csc flags ++ " " ++ debugFlags ++ targetFlags ++ " -nologo -warn:4 " ++ searchFlags ++ linkFlags ++ dquote outcs)
       -- trace cmd $ return ()
       runSystemEcho term flags cmd
       -- run the program
       return (\_ -> return (LinkExe targetName (runSystemEcho term flags targetName)))


{---------------------------------------------------------------
  Javascript
---------------------------------------------------------------}

codeGenJS :: Terminal -> Flags -> (IO () -> IO ()) -> Maybe (Name,Type) -> FilePath -> Core.Core -> IO Link
codeGenJS term flags sequential entry outBase core
  = do let outjs         = outBase ++ ".mjs"
           outName fname = joinPath (dirname outBase) fname
           -- extractImport m = Core.makeImport (modName m) "" {- (modPackageQName m) -} Core.ImportUser Public ""
           js = javascriptFromCore (buildType flags) mbEntry (Core.coreProgImports core) core
           mbEntry = case entry of
                       Just (name,tp) -> Just (name,isAsyncFunction tp)
                       _              -> Nothing
       termTrace term ( "generate javascript: " ++ outjs )
       writeDocW 80 outjs js
       when (showAsmJS flags) (termInfo term js)

       case mbEntry of
        Nothing -> return noLink
        Just  _ ->
         do -- always generate an index.html file
            let outHtml = outName ((if (null (outBaseName flags)) then "index" else (outBaseName flags)) ++ ".html")
                contentHtml = text $ unlines $ [
                                "<!DOCTYPE html>",
                                "<html>",
                                "  <head>",
                                "    <meta charset=\"utf-8\">",
                                "    <script type='module' src='./" ++ notdir outjs ++ "'></script>",
                                "  </head>",
                                "  <body>",
                                "  </body>",
                                "</html>"
                              ]
            termTrace term ("generate index html: " ++ outHtml)
            writeDoc outHtml contentHtml
            case target flags of
              JS JsWeb ->
               do return (\_ -> return (LinkExe outHtml (runSystemEcho term flags (dquote outHtml ++ " &"))))
              _ ->
               do let stksize = if (stackSize flags == 0) then 100000 else (stackSize flags `div` 1024)
                  return (\_ -> return (LinkExe outjs (runCommand term flags
                                           ([node flags,"--stack-size=" ++ show stksize,outjs] ++ execOpts flags)
                                        )))



{---------------------------------------------------------------
  C backend
---------------------------------------------------------------}

codeGenC :: FilePath -> Newtypes -> Borrowed -> Int
             -> Terminal -> Flags -> (IO () -> IO ()) -> Maybe (Name,Type)
              ->FilePath -> Core.Core -> IO Link
codeGenC sourceFile newtypes borrowed0 unique0 term flags sequential entry outBase core0
 = do let outC = outBase ++ ".c"
          outH = outBase ++ ".h"
          sourceDir     = dirname sourceFile
          progName      = Core.coreProgName core0
          mbEntry       = case entry of
                            Just (name,tp) -> Just (name,isAsyncFunction tp)
                            _              -> Nothing
      -- generate C
      let -- (core,unique) = parcCore (prettyEnvFromFlags flags) newtypes unique0 core0
          ctarget = case target flags of
                      C ctarget -> ctarget
                      _         -> CDefault
          (cdoc,hdoc,_,bcore) = cFromCore False
                                          ctarget (buildType flags) sourceDir (prettyEnvFromFlags flags) (platform flags)
                                          newtypes borrowed0 unique0 (parcReuse flags) (parcSpecialize flags) (parcReuseSpec flags)
                                          (parcBorrowInference flags) (optEagerPatBind flags) (stackSize flags) mbEntry
                                          (if null (outputEntryName flags) then "main" else outputEntryName flags)
                                          core0
          bcoreDoc  = Core.Pretty.prettyCore (prettyEnvFromFlags flags){ coreIface = False, coreShowDef = True } (C CDefault) [] bcore

      -- writeDocW 120 (outBase ++ ".c.kkc") bcoreDoc
      when (showFinalCore flags) $
        do termInfo term bcoreDoc

      -- termTrace term ( "generate c: " ++ outBase )
      writeDocW 120 outC (cdoc <.> linebreak)
      writeDocW 120 outH (hdoc <.> linebreak)
      termTrace term ( "generated c: " ++ outBase )
      when (showAsmC flags) (termInfo term (hdoc <//> cdoc))

      -- copy libraries
      let cc       = ccomp flags
          eimports = externalImportsFromCore (target flags) bcore
          clibs    = clibsFromCore flags bcore
      extraIncDirs <- concat <$> mapM (copyCLibrary term flags sequential cc (dirname outBase)) eimports

      -- return the C compilation and final link as a separate IO action to increase concurrency
      return $ \fullImports ->
               do -- compile the generated C
                  ccompile term flags cc outBase extraIncDirs [outC]
                  case entry of
                    Nothing -> return LinkDone
                    Just _  -> codeGenLinkC term flags sequential cc progName fullImports {-link all objs, not just direct imports -}
                                            outBase clibs


-- link obj's and create an executable
codeGenLinkC :: Terminal -> Flags -> (IO () -> IO ()) -> CC -> ModuleName -> [Module]
                  -> FilePath -> [FilePath] -> IO LinkResult
codeGenLinkC term flags sequential cc progName imported outBase clibs
  = do  -- names
        let outName fname = joinPath (dirname outBase) fname
            mainModName = moduleNameToPath progName
            mainName    = if null (outBaseName flags) then mainModName else outBaseName flags
            mainExe     = outName mainName

        -- build kklib for the specified build variant
        kklibObj <- kklibBuild term flags sequential cc (dirname outBase) "kklib" (ccObjFile cc "kklib")

        -- set up linker command line
        let objs   = [kklibObj] ++
                      [outName (ccObjFile cc (moduleNameToPath mname))
                          | mname <- map modName imported ++ [progName]]
                      -- ++ [mainObj]
            syslibs= concat [csyslibsFromCore flags mcore | mcore <- map (fromJust . modCore) imported]
                      ++ ccompLinkSysLibs flags
                      ++ (if onWindows && not (isTargetWasm (target flags))
                            then ["bcrypt","psapi","advapi32"]
                            else ["m","pthread"])
            libs   = -- ["kklib"] -- [normalizeWith '/' (outName (ccLibFile cc "kklib"))] ++ ccompLinkLibs flags
                      -- ++
                      clibs
                      ++
                      concat [clibsFromCore flags mcore | mcore <- map (fromJust . modCore) imported]

            libpaths = map (\lib -> outName (ccLibFile cc lib)) libs

            stksize = if (stackSize flags == 0 && (onWindows || isTargetWasm (target flags)))
                        then 8*1024*1024    -- default to 8Mb on windows and wasi
                        else stackSize flags
            hpsize  = if (heapSize flags == 0 && isTargetWasm (target flags))
                        then 1024*1024*1024 -- default to 1Gb on wasi
                        else heapSize flags

            linkFlags = [ ccFlagsLink cc
                        , ccFlagStack cc stksize
                        , ccFlagHeap cc hpsize]

            linkLibs  = map (ccAddLib cc) libpaths  -- libs
                        ++ map (ccAddSysLib cc) syslibs

            clink  = concat $
                      [ [ccPath cc]
                      , ccFlags cc
                      , ccFlagsBuildFromFlags cc flags
                      , ccTargetExe cc mainExe
                      ]
                      ++ [objs]
                      ++ linkFlags  -- must be last due to msvc
                      -- ++ [ccAddLibraryDir cc (fullBuildDir flags)]
                      ++ linkLibs


        -- link
        let termShow pre post
              = termInfo term (color (colorInterpreter (colorScheme flags)) (fill 14 (text pre) <.> colon) <+>
                                color (colorSource (colorScheme flags)) (text (unwords post)))
        if (not (null (outputEntryName flags)))
          then do -- the main entry name is not "main" so we cannot link into an exe directly; show instead all link information
                  -- todo: properly create an archive?
                  termShow "link command"     ([ccPath cc] ++ ccFlags cc)
                  termShow "link objects"     objs
                  termShow "link flags"       (concat linkFlags)
                  termShow "link libraries"   (concat linkLibs)
                  termShow "link target"      [mainExe ++ exeExtension]
                  return LinkDone
          else do codeGenLinkExe term flags stksize clink mainExe


codeGenLinkExe :: Terminal -> Flags -> Int -> [String] -> [Char] -> IO LinkResult
codeGenLinkExe term flags stksize clink mainExe
  = do  runCommand term flags clink

        -- return command line to execute
        let mainTarget = mainExe ++ targetExeExtension (target flags)
        when (not (null (outFinalPath flags)) && verbose flags > 1) $
          termPhase term $ color (colorInterpreter (colorScheme flags)) (text "created :") <+>
                                color (colorSource (colorScheme flags)) (text (normalizeWith pathSep mainTarget))
        let mainflags = (if (showElapsed flags) then ["--kktime"] else []) ++ execOpts flags

        -- termInfo term $ text "flags:" <+> text (show flags) <+> text "\n"
        case target flags of
          C Wasm
            -> do return (LinkExe mainTarget
                            (runCommand term flags ([wasmrun flags,mainTarget] ++ mainflags)))
          C WasmWeb
            -> do return (LinkExe mainTarget
                            (runSystemEcho term flags (dquote mainTarget ++ " &")))
          C WasmJs
            -> do let nodeStack = if (stksize == 0) then 100000 else (stksize `div` 1024)
                  return (LinkExe mainTarget
                            (runCommand term flags ([node flags,"--stack-size=" ++ show nodeStack,mainTarget] ++ mainflags)))
          _ -> do return (LinkExe mainTarget
                            (runCommand term flags ([mainExe] ++ mainflags)))



-- Run the C compiler
ccompile :: Terminal -> Flags -> CC -> FilePath -> [FilePath] -> [FilePath] -> IO ()
ccompile term flags cc ctargetObj extraIncDirs csources
  = do let cmdline = concat $
                      [ [ccPath cc]
                      , ccFlags cc
                      , ccFlagsWarn cc
                      , ccFlagsBuildFromFlags cc flags
                      , ccFlagsCompile cc
                      , ccIncludeDir cc (localShareDir flags ++ "/kklib/include")
                      ]
                      ++
                      map (ccIncludeDir cc) (extraIncDirs ++ ccompIncludeDirs flags)
                      ++
                      map (ccAddDef cc) (ccompDefs flags)
                      ++
                      [ ccTargetObj cc (notext ctargetObj)
                      , csources
                      ]
       runCommand term flags cmdline



{---------------------------------------------------------------
  C libraries
---------------------------------------------------------------}

-- copy static C library to the output directory (so we can link and/or bundle) and
-- return needed include paths for imported C code
copyCLibrary :: Terminal -> Flags -> (IO () -> IO ()) -> CC -> FilePath -> [(String,String)] -> IO [FilePath] {-include paths-}
copyCLibrary term flags sequential cc outDir eimport
  = case Core.eimportLookup (buildType flags) "library" eimport of
      Nothing -> return []
      Just clib
        -> do mb  <- do mbSearch <- search [] [ searchCLibrary flags cc clib (ccompLibDirs flags)
                                              , case lookup "vcpkg" eimport of
                                                  Just pkg
                                                    -> vcpkgCLibrary term flags sequential cc eimport clib pkg
                                                  _ -> return (Left [])
                                              , case lookup "conan" eimport of
                                                  Just pkg | not (null (conan flags))
                                                    -> conanCLibrary term flags sequential cc eimport clib pkg
                                                  _ -> return (Left [])
                                              ]
                        case mbSearch of
                          Right res -> return (Just res)
                          Left warn -> do termWarning term flags warn
                                          return Nothing
              case mb of
                Just (libPath,includes)
                  -> do termPhase term (color (colorInterpreter (colorScheme flags)) (text "library :") <+>
                          color (colorSource (colorScheme flags)) (text libPath))
                        -- this also renames a suffixed libname to a canonical name (e.g. <vcpkg>/pcre2-8d.lib -> <out>/pcre2-8.lib)
                        sequential $ copyBinaryIfNewer (rebuild flags) libPath (joinPath outDir (ccLibFile cc clib))
                        return includes
                Nothing
                  -> -- TODO: suggest conan and/or vcpkg install?
                     do termWarning term flags $
                          text "unable to find C library:" <+> color (colorSource (colorScheme flags)) (text clib) <->
                          text "   hint: provide \"--cclibdir\" as an option, or use \"syslib\" in an extern import?"
                        raiseIO ("unable to find C library " ++ clib ++
                                 "\nlibrary search paths: " ++ show (ccompLibDirs flags))
  where
    search :: [Doc] -> [IO (Either [Doc] (FilePath,[FilePath]))] -> IO (Either Doc (FilePath,[FilePath]))
    search warns [] = return (Left (vcat (intersperse (text "or") warns)))
    search warns (io:ios)
      = do mbRes <- io
           case mbRes of
             Right res   -> return (Right res)
             Left warns' -> search (warns ++ warns') ios

searchCLibrary :: Flags -> CC -> FilePath -> [FilePath] -> IO (Either [Doc] (FilePath {-libPath-},[FilePath] {-include paths-}))
searchCLibrary flags cc clib searchPaths
  = do mbPath <- -- looking for specific suffixes is not ideal but it differs among plaforms (e.g. pcre2-8 is only pcre2-8d on Windows)
                 -- and the actual name of the library is not easy to extract from vcpkg (we could read
                 -- the lib/config/<lib>.pc information and parse the Libs field but that seems fragile as well)
                 do let suffixes = (if (buildType flags <= Debug) then ["d","_d","-d","-debug","_debug","-dbg","_dbg"] else [])
                    -- trace ("search in: " ++ show searchPaths) $
                    searchPathsSuffixes searchPaths [] suffixes (ccLibFile cc clib)
       case mbPath of
        Just fname
          -> case reverse (splitPath fname) of
               (_:"lib":"debug":rbase) -> return (Right (fname, [joinPaths (reverse rbase ++ ["include"])])) -- for vcpkg
               (_:"lib":rbase)         -> return (Right (fname, [joinPaths (reverse rbase ++ ["include"])])) -- e.g. /usr/local/lib
               _                       -> return (Right (fname, []))
        _ -> return (Left [])



{---------------------------------------------------------------
  Package managers: Conan and VCPkg
---------------------------------------------------------------}

conanCLibrary :: Terminal -> Flags -> (IO () -> IO ()) -> CC -> [(String,String)] -> FilePath -> String -> IO (Either [Doc] (FilePath,[FilePath]))
conanCLibrary term flags sequential cc eimport clib pkg
  = do mbConanCmd <- searchProgram (conan flags)
       case mbConanCmd of
         Nothing
          -> do return $ Left [text "this module requires a conan package but \"" <.> clrSource (text (conan flags)) <.> text "\" is not installed."
                                     <-> text "         install conan as:"
                                     <-> text "         >" <+> clrSource (text "pip3 install conan")
                                     <-> text "         or see <" <.> clrSource (text "https://docs.conan.io/en/latest/installation.html") <.> text ">"]
         Just conanCmd | onWindows && not (any (\pre -> ccName cc `startsWith` pre) ["cl","clang-cl"])
          -> do return $ Left [text "conan can only be used with the 'cl' or 'clang-cl' compiler on Windows"]
         Just conanCmd | isTargetWasm (target flags)
          -> do return $ Left [text "conan can not be used with a wasm target"]
         Just conanCmd
          -> do mbPkgDir <- getPackageDir conanCmd
                case mbPkgDir of
                  Nothing
                    -> do termWarning term flags $
                            text "unable to resolve conan package:" <+> clrSource (text pkg)
                          return (Left [])
                  Just (pkgName,pkgDir)
                    -> do termPhase term $ color (colorInterpreter (colorScheme flags)) $
                            text "package : conan" <+> clrSource (text pkgName) -- <.> colon <+> clrSource (text pkgDir)
                          let libDir = pkgDir ++ "/lib"
                          searchCLibrary flags cc clib [libDir]

  where
    pkgBase
      = takeWhile (/='/') pkg

    (baseSettings,conanEnv)
      = conanSettingsFromFlags flags cc

    settings
      = baseSettings ++ ["-o",pkgBase ++ "/*:shared=False","-o","shared=False"]

    clrSource doc
      = color (colorSource (colorScheme flags)) doc

    getPackageDir conanCmd
      = do mbPkgDir <- findPackagDir conanCmd
           case mbPkgDir of
             Just _   -> return mbPkgDir
             Nothing  -> do installPackage conanCmd
                            findPackagDir conanCmd

    findPackagDir conanCmd
      = do -- find out latest installed version
           let infoCmd = [conanCmd, "list", "-c", pkg]
           out <- runCommandRead term flags conanEnv infoCmd `catchIO` (\msg -> return "")
           -- termTrace term out
           let cachepkg = dropWhile isSpace $ concat $ take 1 $ dropWhile (all isSpace) $ reverse (lines out)
           if (not (cachepkg `startsWith` pkgBase))
             then return Nothing
             else -- and get the binary package location
                  do let queryCmd = [conanCmd, "install", "--requires", cachepkg] ++ settings
                     (_,out) <- runCommandReadAll term flags conanEnv queryCmd `catchIO` (\msg -> return ("",""))
                     -- termTrace term out
                     let prefix = cachepkg ++ ": Appending PATH environment variable: "
                         ppaths = [reverse $ drop 4 {- /bin -} $ reverse $
                                    drop (length prefix) line | line <- lines out, line `startsWith` prefix]
                     termTrace term (show (lines out))
                     termTrace term (unlines ppaths)
                     case ppaths of
                       [ppath] -> do exist <- doesDirectoryExist ppath
                                     return (if exist then Just (cachepkg,ppath) else Nothing)
                       _       -> return Nothing


    installPackage conanCmd
      = do let installCmd = [conanCmd, "install", "--build", "missing", "--requires", pkg] ++ settings
           if not (autoInstallLibs flags)
             then termWarning term flags (text "this module requires the conan package"
                    <+> clrSource (text pkg)
                    <+> text "         enable auto install using the \"--autoinstall\" option to koka,"
                    <+> text "         or install the package manually as:"
                    <-> text "         >" <+> clrSource (text (unwords installCmd))
                    <-> text "         to install the required C library and header files")
             else do let profileCmd = [conanCmd, "profile", "detect"] -- ensure default profile exists
                     sequential $ do runCommandReadAll term flags conanEnv profileCmd `catchIO` (\msg -> return ("",""))
                                     return ()
                     termPhase term (color (colorInterpreter (colorScheme flags)) (text "install: conan package:") <+> clrSource (text pkg))
                     sequential $ runCommandEnv term flags conanEnv installCmd


vcpkgCLibrary :: Terminal -> Flags -> (IO () -> IO ()) -> CC -> [(String,String)] -> FilePath -> String -> IO (Either [Doc] (FilePath,[FilePath]))
vcpkgCLibrary term flags sequential cc eimport clib pkg
  = do (root,vcpkg) <- vcpkgFindRoot (vcpkgRoot flags)
       exist <- doesFileExist vcpkg
       if (not exist)
         then do return $ Left [
                    text "this module requires vcpkg to install the" <+> clrSource (text clib) <+> text "library." <->
                    text "   hint: specify the root directory of vcpkg using the" <+> clrSource (text "--vcpkg=<dir>") <+> text "option" <->
                    text "         or the" <+> clrSource (text "VCPKG_ROOT") <+> text "environment variable," <->
                  (if onMacOS then
                   (text "         or install vcpkg as:" <->
                    text "         > brew install vcpkg")
                   else
                   (text "         or install vcpkg from <" <.> clrSource (text "https://vcpkg.io/en/getting-started.html") <.> text ">"))
                  ]
         else do let libDir = root ++ "/installed/" ++ (vcpkgTriplet flags)
                                ++ (if buildType flags <= Debug then "/debug/lib" else "/lib")
                 termPhase term $ color (colorInterpreter (colorScheme flags)) $
                    text "package : vcpkg" <+> clrSource (text pkg)
                 mbInstalled <- searchCLibrary flags cc clib [libDir]
                 case mbInstalled of
                   Right _ -> return mbInstalled
                   Left _  -> install root libDir vcpkg
  where
    clrSource doc
      = color (colorSource (colorScheme flags)) doc

    install rootDir libDir vcpkgCmd
      = do  let packageDir = joinPaths [rootDir,"packages",pkg ++ "_" ++ vcpkgTriplet flags]
            pkgExist <- doesDirectoryExist packageDir
            when (pkgExist) $
              termWarning term flags $
                text "vcpkg" <+> clrSource (text pkg) <+>
                text "is installed but the library" <+> clrSource (text clib) <+>
                text "is not found in" <+> clrSource (text libDir)
            let installCmd = [vcpkgCmd, "install", pkg ++ ":" ++ vcpkgTriplet flags, "--disable-metrics"]
            if (not (autoInstallLibs flags))
              then do termWarning term flags (text "this module requires vcpkg package"
                                              <+> clrSource (text pkg)
                                              <-> text "   hint: enable auto install using the \"--autoinstall\" option to koka,"
                                              <-> text "         or install the package manually as:"
                                              <-> text "         >" <+> clrSource (text (unwords installCmd))
                                              <-> text "         to install the required C library and header files")
                      return (Left [])
              else do termPhase term (color (colorInterpreter (colorScheme flags)) (text "install: vcpkg package:") <+> clrSource (text pkg))
                      sequential $ runCommand term flags installCmd
                      searchCLibrary flags cc clib [libDir] -- try to find again after install

clibsFromCore flags core    = externalImportKeyFromCore (target flags) (buildType flags) core "library"
csyslibsFromCore flags core = externalImportKeyFromCore (target flags) (buildType flags) core "syslib"


externalImportKeyFromCore :: Target -> BuildType -> Core.Core -> String -> [String]
externalImportKeyFromCore target buildType core key
  = catMaybes [Core.eimportLookup buildType key keyvals  | keyvals <- externalImportsFromCore target core]

externalImportsFromCore :: Target -> Core.Core -> [[(String,String)]]
externalImportsFromCore target core
  = [keyvals  | Core.ExternalImport imports _ <- Core.coreProgExternals core, (target,keyvals) <- imports]


{---------------------------------------------------------------
  kklib
---------------------------------------------------------------}

kklibBuild :: Terminal -> Flags -> (IO () -> IO ()) -> CC -> FilePath -> String -> FilePath -> IO FilePath
kklibBuild term flags sequential cc outDir name {-kklib-} objFile {-libkklib.o-}
  = do let objPath = joinPath outDir objFile  {-out/v2.x.x/clang-debug/libkklib.o-}
       exist <- doesFileExist objPath
       let binObjPath = joinPath (localLibDir flags) (buildVariant flags ++ "/" ++ objFile)
       let srcLibDir  = joinPath (localShareDir flags) (name)
       binExist <- doesFileExist binObjPath
       binNewer <- if (not binExist) then return False
                   else if (not exist) then return True
                   else do cmp <- fileTimeCompare binObjPath objPath
                           return (cmp==GT)
       srcNewer <- if (binNewer) then return False -- no need to check
                   else if (not exist) then return True
                   else do cmp <- fileTimeCompare (srcLibDir ++ "/include/kklib.h") objPath
                           return (cmp==GT)
       -- putStrLn ("binObjPath: " ++ binObjPath ++ ", newer: " ++ show binNewer)
       if (not binNewer && not srcNewer && not (rebuild flags))
        then return ()
         else if (binNewer)
           then -- use pre-compiled installed binary
                sequential $ copyBinaryFile binObjPath objPath
           else -- todo: check for installed binaries for the library
                -- compile kklib from sources
                do termInfo term $ color (colorInterpreter (colorScheme flags)) (text ("compile :")) <+>
                                   color (colorSource (colorScheme flags)) (text name) <+>
                                    color (colorInterpreter (colorScheme flags)) (text "from:") <+>
                                     color (colorSource (colorScheme flags)) (text srcLibDir)
                   let flags0 = if (useStdAlloc flags) then flags
                                  else flags{ ccompIncludeDirs = ccompIncludeDirs flags ++ [localShareDir flags ++ "/kklib/mimalloc/include"] }
                       flags1 = flags0{ ccompDefs = ccompDefs flags ++
                                                    [("KK_COMP_VERSION","\"" ++ version ++ "\""),
                                                     ("KK_CC_NAME", "\"" ++ ccName cc ++ "\"")] }
                   sequential $ ccompile term flags1 cc objPath [] [joinPath srcLibDir "src/all.c"]
       return objPath


{---------------------------------------------------------------
  Helpers
---------------------------------------------------------------}

termWarning term flags doc
  = termInfo term $ color (colorWarning (colorSchemeFromFlags flags)) (text "warning:" <+> doc)

runSystemEcho :: Terminal -> Flags -> String -> IO ()
runSystemEcho term flags cmd
  = do phaseVerboseIO term flags 3 "shell" $ \penv -> text cmd
       runSystem cmd

runCommand :: Terminal -> Flags -> [String] -> IO ()
runCommand term flags cargs@(cmd:args)
  = do let command = shellQuoted cargs
       if (onWindows && cmd `endsWith` "emcc") -- hack to run emcc correctly on windows (due to Python?)
         then runSystemEcho term flags command
         else  do phaseVerboseIO term flags 3 "command" $ \penv -> text command -- cmd ++ " [" ++ concat (intersperse "," args) ++ "]")
                  runCmd cmd (filter (not . null) args)
                    `catchIO` (\msg -> raiseIO ("error  : " ++ msg ++ "\ncommand: " ++ command))

runCommandRead :: Terminal -> Flags -> [(String,String)] -> [String] -> IO String
runCommandRead term flags env cargs
  = do (out,_) <- runCommandReadAll term flags env cargs
       return out

runCommandReadAll :: Terminal -> Flags -> [(String,String)] -> [String] -> IO (String,String)
runCommandReadAll term flags env cargs@(cmd:args)
  = do let command = unwords (shellQuote cmd : map shellQuote args)
       phaseVerboseIO term flags 3 "command" $ \penv -> text command -- cmd ++ " [" ++ concat (intersperse "," args) ++ "]")
       runCmdRead env cmd (filter (not . null) args)
         `catchIO` (\msg -> raiseIO ("error  : " ++ msg ++ "\ncommand: " ++ command))

runCommandEnv :: Terminal -> Flags -> [(String,String)] -> [String] -> IO ()
runCommandEnv term flags env cargs@(cmd:args)
  = do let command = unwords (shellQuote cmd : map shellQuote args)
       phaseVerboseIO term flags 3 "command" $ \penv -> text command -- cmd ++ " [" ++ concat (intersperse "," args) ++ "]")
       runCmdEnv env  cmd (filter (not . null) args)
         `catchIO` (\msg -> raiseIO ("error  : " ++ msg ++ "\ncommand: " ++ command))

shellQuoted :: [String] -> String
shellQuoted args
  = unwords (map shellQuote args)

shellQuote s
  = if (all (\c -> isAlphaNum c || c `elem` ":/-_.=") s) then s
     else dquote s

joinWith sep xs
  = concat (intersperse sep xs)

dquote s
  = "\"" ++ concatMap quote s ++ "\""
  where
    quote '"'  = "\\\""
    quote '\'' = "\\'"
    quote c    = [c]

compilerCatch comp term defValue io
  = io `catchSystem` \msg ->
    do (termError term) (errorMessageKind ErrBuild rangeNull
                           (hang 2 $ text ("failure during " ++ comp ++ ":")
                                           <-> string msg)) -- (fillSep $ map string $ words msg)))
       return defValue

catchSystem io f
  = io `catchIO` (\msg -> let cmdFailed = "command failed:" in
                          if (cmdFailed `isPrefixOf` msg)
                           then f (drop (length cmdFailed) msg)
                           else f msg)


